home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / xlibpas2.zip / XLIBDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1994-06-12  |  18KB  |  516 lines
  1. { VERY QUICK AND ULTRA-DIRTY DEMO USING XLIB
  2.     Simple Demo of MODE X Split screen and panning
  3.     Compile using Borland/Turbo Pascal 6.0/7.0 }
  4.  
  5. {$IFDEF DPMI}
  6. {$C FIXED PRELOAD PERMANENT}
  7. {$ENDIF}
  8.  
  9. Program Xlibdemo;
  10.  
  11. Uses
  12.     Crt, XLib2, xbm2;
  13.  
  14. Const
  15.     MaxObjects = 10;
  16.     ObjectCount : integer = 0;
  17.     bm : array[0..193] of byte =
  18.         (4,12,
  19.         2,2,2,2,2,1,1,1,2,1,1,1,2,3,3,1,
  20.         2,0,0,3,2,0,0,3,2,0,0,3,2,0,0,3,
  21.         2,3,3,1,2,1,1,1,2,1,1,1,2,2,2,2,
  22.         2,2,2,2,1,1,1,1,1,1,1,1,1,3,3,1,
  23.         1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,
  24.         1,3,3,1,1,1,1,1,1,1,1,1,2,2,2,2,
  25.         2,2,2,2,1,1,1,1,1,1,1,1,1,3,3,1,
  26.         1,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,
  27.         1,3,3,1,1,1,1,1,1,1,1,1,2,2,2,2,
  28.         2,2,2,2,1,1,1,2,1,1,1,2,1,3,3,2,
  29.         3,0,0,2,3,0,0,2,3,0,0,2,3,0,0,2,
  30.         1,3,3,2,1,1,1,2,1,1,1,2,2,2,2,2 );
  31.  
  32.     bm2 : array[0..193] of byte =
  33.         (4,12,
  34.         2,2,2,2,2,4,4,4,2,4,4,4,2,2,2,4,
  35.         2,0,0,2,2,0,0,2,2,0,0,2,2,0,0,2,
  36.         2,2,2,4,2,4,4,4,2,4,4,4,2,2,2,2,
  37.         2,2,2,2,4,4,4,4,4,4,4,4,4,2,2,4,
  38.         4,0,0,4,4,0,0,4,4,0,0,4,4,0,0,4,
  39.         4,2,2,4,4,4,4,4,4,4,4,4,2,2,2,2,
  40.         2,2,2,2,4,4,4,4,4,4,4,4,4,2,2,4,
  41.         4,0,0,4,4,0,0,4,4,0,0,4,4,0,0,4,
  42.         4,2,2,4,4,4,4,4,4,4,4,4,2,2,2,2,
  43.         2,2,2,2,4,4,4,2,4,4,4,2,4,2,2,2,
  44.         2,0,0,2,2,0,0,2,2,0,0,2,2,0,0,2,
  45.         4,2,2,2,4,4,4,2,4,4,4,2,2,2,2,2);
  46.  
  47.     palscrolldir : integer = 1;
  48.     textwindowx : integer = 0;
  49.     textwindowy : integer = 0;
  50. Type
  51.     AnimatedObject = record
  52.         X,Y,Width,Height,XDir,YDir,XOtherPage,YOtherPage : integer;
  53.         Image, bg, bgOtherPage : pointer;
  54.     end;
  55.  
  56. Var
  57.     objects : array[0..MaxObjects] of AnimatedObject;
  58.     userfnt1, pal, pal2, SaveExitProc : pointer;
  59.     xpos : integer;
  60.  
  61. procedure initobject( x, y, width, height, xdir, ydir : integer;
  62.                                             var image : pointer );
  63. begin
  64.     objects[objectcount].X := x;
  65.     objects[objectcount].XOtherPage := x;
  66.     objects[objectcount].Y := y;
  67.     objects[objectcount].YOtherPage := y;
  68.     objects[objectcount].Width := width;
  69.     objects[objectcount].Height := height;
  70.     objects[objectcount].XDir := xdir;
  71.     objects[objectcount].YDir := ydir;
  72.     objects[objectcount].Image := image;
  73.     GetMem( objects[objectcount].bg, 4*width*height+20);
  74.     GetMem( objects[objectcount].bgOtherPage, 4*width*height+20);
  75.     xgetpbm(x,y,width,height,VisiblePageOffs, objects[objectcount].bg^);
  76.     xgetpbm(x,y,width,height,HiddenPageOffs, objects[objectcount].bgOtherPage^);
  77.     inc(objectcount);
  78. end;
  79.  
  80. procedure MoveObject( var ObjectToMove : AnimatedObject );
  81. var
  82.     X, Y : integer;
  83.     cptr : pointer;
  84. begin
  85.     X := ObjectToMove.X + ObjectToMove.XDir;
  86.     Y := ObjectToMove.Y + ObjectToMove.YDir;
  87.     if (X < 0) or (X > (ScrnLogicalPixelWidth-(ObjectToMove.Width shl 2))) then
  88.     begin
  89.         ObjectToMove.XDir := -ObjectToMove.XDir;
  90.         X := ObjectToMove.X + ObjectToMove.XDir;
  91.      end;
  92.     if (Y < 0) or (Y > (ScrnLogicalHeight-ObjectToMove.Height)) then
  93.     begin
  94.         ObjectToMove.YDir := -ObjectToMove.YDir;
  95.         Y := ObjectToMove.Y + ObjectToMove.YDir;
  96.     end;
  97.     ObjectToMove.XOtherPage := ObjectToMove.X;
  98.     ObjectToMove.YOtherPage := ObjectToMove.Y;
  99.     ObjectToMove.X := X;
  100.     ObjectToMove.Y := Y;
  101.     cptr := ObjectToMove.bg;
  102.     ObjectToMove.bg := ObjectToMove.bgOtherPage;
  103.     ObjectToMove.bgOtherPage := cptr;
  104. end;
  105.  
  106. procedure animate;
  107. var
  108.     i : integer;
  109. begin
  110.     for i:=objectcount-1 downto 0 do
  111.         xputpbm(objects[i].XOtherPage,objects[i].YOtherPage,
  112.             HiddenPageOffs,objects[i].bgOtherPage^);
  113.     for i:=0 to objectcount-1 do
  114.     begin
  115.         MoveObject(objects[i]);
  116.         xgetpbm(objects[i].X,objects[i].Y,
  117.             objects[i].Width,objects[i].Height,HiddenPageOffs,
  118.             objects[i].bg^);
  119.         xputmaskedpbm(objects[i].X,objects[i].Y,HiddenPageOffs,
  120.             objects[i].Image^);
  121.  end;
  122. end;
  123.  
  124. procedure clearobjects;
  125. var
  126.     i : integer;
  127. begin
  128.     for i:=objectcount-1 downto 0 do
  129.         xputpbm(objects[i].XOtherPage,objects[i].YOtherPage,
  130.             HiddenPageOffs,objects[i].bgOtherPage^);
  131. end;
  132.  
  133.  
  134. procedure textwindow( Margin : integer );
  135. var
  136.     x0, y0, x1, y1 : integer;
  137. begin
  138.      x0 := Margin;
  139.      y0 := Margin;
  140.      x1 := ScrnPhysicalPixelWidth-Margin;
  141.      y1 := ScrnPhysicalHeight-Margin;
  142.      xrectfill(x0, y0, x1,y1,VisiblePageOffs,1);
  143.      xline(x0,y0,x1,y0,2,VisiblePageOffs);
  144.      xline(x0,y1,x1,y1,2,VisiblePageOffs);
  145.      xline(x0,y0,x0,y1,2,VisiblePageOffs);
  146.      xline(x1,y0,x1,y1,2,VisiblePageOffs);
  147.      xline(x0+2,y0+2,x1-2,y0+2,2,VisiblePageOffs);
  148.      xline(x0+2,y1-2,x1-2,y1-2,2,VisiblePageOffs);
  149.      xline(x0+2,y0+2,x0+2,y1-2,2,VisiblePageOffs);
  150.      xline(x1-2,y0+2,x1-2,y1-2,2,VisiblePageOffs);
  151.      textwindowx:=x0;
  152.      textwindowy:=y0;
  153. end;
  154.  
  155.  
  156. procedure waitforkeypress;
  157. begin
  158.     xshowmouse;
  159.     while keypressed do readkey;
  160.     while MouseButtonStatus=LeftPressed do;
  161.     palscrolldir := 1-palscrolldir;
  162.     while (not keypressed) and (MouseButtonStatus<>LeftPressed) do
  163.     begin
  164.         xrotpalstruc(pal^,palscrolldir);
  165.         {Notice that there is no need to freeze and update the mouse if the
  166.          vsync handler is installed while just updating the palette, because the
  167.          DAC is changed before the mouse handler is called}
  168. {$IFDEF DPMI}
  169.         mousefrozen := 1;
  170. {$ENDIF}
  171.         xputpalstruc(pal^);
  172. {$IFDEF DPMI}
  173.         xupdatemouse;
  174. {$ENDIF}
  175.     end;
  176.     while keypressed do readkey;
  177.     while MouseButtonStatus=LeftPressed do;
  178. end;
  179.  
  180.  
  181. procedure quit; far;
  182. begin
  183. {$IFDEF DPMI}
  184.     xremovevsynchandler;
  185. {$ENDIF}
  186.     xmouseremove;
  187.     textmode(co80+font8x8);
  188.     ExitProc := SaveExitProc;
  189. end;
  190.  
  191. procedure intro1;
  192. begin
  193.     xsetrgb(1,40,40,40);
  194.     xsetrgb(2,63,63,0);
  195.     xsetrgb(3,63,0,0);
  196.     xsetrgb(4,0,63,0);
  197.     xsetrgb(5,0,0,63);
  198.     xsetrgb(6,0,0,28);
  199.     xsetrgb(7,0,28,0);
  200.     xsetrgb(8,28,0,0);
  201.     xsetrgb(9,0,0,38);
  202.     textwindow(20);
  203.     xsetfont(1);
  204.     xpos := xcentre(180,textwindowy+4,VisiblePageOffs,6,'XLibPas Version 2.0');
  205.     xprintf(xpos-1,textwindowy+3,VisiblePageOffs,2,'XLibPas Version 2.0');
  206.     xsetfont(0);
  207.     xpos := xcentre(180,168,VisiblePageOffs,6,'Press any key to continue');
  208.     xprintf(xpos-1,167,VisiblePageOffs,2,'Press any key to continue');
  209. end;
  210.  
  211. procedure subsequentpage;
  212. begin
  213.     xhidemouse;
  214.     textwindow(20);
  215.     xsetfont(1);
  216.     xpos := xcentre(180,textwindowy+4,VisiblePageOffs,6,'XLibPas Version 2.0');
  217.     xprintf(xpos-1,textwindowy+3,VisiblePageOffs,2,'XLibPas Version 2.0');
  218.     xsetfont(0);
  219.     xpos := xcentre(180,168,VisiblePageOffs,6,'Press any key to continue');
  220.     xprintf(xpos-1,167,VisiblePageOffs,2,'Press any key to continue');
  221.  
  222. end;
  223.  
  224. procedure loaduserfonts;
  225. var
  226.     f : File;
  227. begin
  228.     assign(f,'fonts\var6x8.fnt');
  229.     reset(f,1);
  230.     blockread( f, userfnt1^, filesize(f) );
  231.     close(f);
  232.     xregisteruserfont(userfnt1^);
  233. end;
  234.  
  235.  
  236.  
  237. procedure main;
  238. var
  239.     i, j, xinc, yinc, Margin : integer;
  240.     ch : char;
  241.     a : byte;
  242.     currx, curry : word;
  243.     x0,x1,x2,y0,y1,y2 : integer;
  244.     pt : pointer;
  245. begin
  246.     GetMem(pal,256*3);
  247.     GetMem(pal2,256*3);
  248.     GetMem(userfnt1,256*16+4);
  249.     currx := 0;
  250.     curry := 0;
  251.  
  252.     xtextmode;
  253.     xsetmode(XMODE360x200,500);
  254. {$IFNDEF DPMI}
  255.     xinstallvsynchandler(1);
  256. {$ENDIF}
  257.     xsetsplitscreen(ScrnPhysicalHeight-61);
  258.     xsetdoublebuffer(220);
  259.     xhidesplitscreen;
  260.     xtextinit;
  261.     xmouseinit;
  262.     xmousewindow(0,0,359,199);
  263.     mousecolor := 2;
  264.     for j:=0 to ScrnPhysicalHeight-1 do
  265.         xline(0,j,ScrnLogicalPixelWidth,j,16+(j mod 239),VisiblePageOffs);
  266.  
  267.     xgetpalstruc(pal^,240,16);
  268.     loaduserfonts;
  269.     intro1;
  270.     xsetfont(2);
  271.     xhidemouse;
  272.     xprintf(textwindowx+5,50   ,VisiblePageOffs,9, '  Hi, folks. This is yet another FREEWARE Mode X graphics');
  273.     xprintf(textwindowx+5,50+8 ,VisiblePageOffs,9, ' library. It is by no means complete, but I believe it');
  274.     xprintf(textwindowx+5,50+16,VisiblePageOffs,9, ' contains a rich enough set of functions to achieve its');
  275.     xprintf(textwindowx+5,50+24,VisiblePageOffs,9, ' design goal : a game development oriented library for');
  276.     xprintf(textwindowx+5,50+32,VisiblePageOffs,9, ' Borland TP/BP programmers.');
  277.  
  278.     xprintf(textwindowx+5,50+48,VisiblePageOffs,9, '  This library comes with BP/TP sources.');
  279.     xprintf(textwindowx+5,50+56,VisiblePageOffs,9, ' It was inspired by the DDJ Graphics column and many');
  280.     xprintf(textwindowx+5,50+64,VisiblePageOffs,9, ' INTERNET and USENET authors who, unlike the majority of');
  281.     xprintf(textwindowx+5,50+72,VisiblePageOffs,9, ' programmers (you know who you are!), willingly share');
  282.     xprintf(textwindowx+5,50+80,VisiblePageOffs,9, ' their code and ideas with others.');
  283.  
  284.  
  285.